home *** CD-ROM | disk | FTP | other *** search
/ Univers Mac Interactif 53 / Univers Mac Interactif - Issue 53.iso / UNIVERS MAC 53 / Hypercard / Sans-Faute⁄Grammaire® / Sans-Faute⁄Grammaire ƒ / Pour les autres applications / 4D / External SFG pour 4D / Sources / ExternalSFG.p < prev    next >
Text File  |  1995-09-07  |  11KB  |  395 lines
  1.  
  2. unit ExternalSFG;
  3.  
  4. interface
  5.  
  6.     uses
  7.         AppleTalk, Processes, PPCToolBox, EPPC, Notification, AppleEvents, AERegistry, Ext4D;
  8.  
  9.     const
  10.         CheckDialogID = 16666;
  11.  
  12. (* renvoie errAEWaitCanceled (-1711) si l'utilisateur a annulé la vérification dans Sans-Faute/Grammaire *)
  13.  
  14.     procedure main (entryPoint: Longint; params: PackagePtr; var data: Handle; var resultmain: longint);
  15.  
  16. implementation
  17.  
  18.     const
  19.         SFGsignature = 'SFGr';
  20.  
  21.  
  22.     function launchSFG: OSErr;
  23.  
  24.         var
  25.             process: ProcessSerialNumber;
  26.             InfoRec: ProcessInfoRec;
  27.             DeskTopPB: DTPBRec;
  28.             volPB: HParamBlockRec;
  29.             SFGFound: Boolean;
  30.             SFGFSSpec: FSSpec;
  31.             err: OSErr;
  32.             theLaunchParams: LaunchParamBlockRec;
  33.             block: ParameterBlock;
  34.  
  35.     begin
  36.         process.highLongOfPSN := 0;
  37.         process.lowLongOfPSN := kNoProcess;
  38.         InfoRec.processInfoLength := sizeof(ProcessInfoRec);
  39.         InfoRec.processName := nil;
  40.         InfoRec.processAppSpec := nil;
  41.         SFGFound := false;
  42.         while not SFGFound & (GetNextProcess(process) = noErr) do
  43.             if GetProcessInformation(process, InfoRec) = noErr then
  44.                 if (InfoRec.processType = longint('APPL')) and (InfoRec.processSignature = SFGsignature) then
  45.                     SFGFound := true;
  46.  
  47.         if SFGFound then
  48.             begin
  49.                 launchSFG := noErr;
  50.                 exit(launchSFG);
  51.             end;
  52.  
  53.         volPB.ioNamePtr := nil;
  54.         volPB.ioVolIndex := 1;
  55.         SFGFound := false;
  56.         while not SFGFound & (PBHGetVInfo(@volPB, false) = noErr) do
  57.             with DeskTopPB do
  58.                 begin
  59.                     ioNamePtr := nil;
  60.                     ioVRefnum := volPB.ioVRefnum;
  61.                     if PBDTGetPath(@DeskTopPB) = noErr then
  62.                         begin
  63.                             ioNamePtr := @SFGFSSpec.name;
  64.                             ioIndex := 0;
  65.                             ioFileCreator := SFGsignature;
  66.                             if PBDTGetAPPL(@DeskTopPB, false) = noErr then
  67.                                 begin
  68.                                     SFGFSSpec.vRefnum := volPB.ioVRefnum;
  69.                                     SFGFSSpec.parID := ioAPPLParID;
  70.                                     SFGFound := true;
  71.                                 end;
  72.                         end;
  73.                     volPB.ioVolIndex := volPB.ioVolIndex + 1;
  74.                 end;
  75.         if not SFGFound then
  76.             begin
  77.                 launchSFG := fnfErr;
  78.                 exit(launchSFG);
  79.             end;
  80.  
  81.         with theLaunchParams do
  82.             begin
  83.                 launchBlockID := extendedBlock;
  84.                 launchEPBLength := extendedBlockLen;
  85.                 launchFileFlags := 0;
  86.                 launchControlFlags := launchContinue + launchNoFileFlags;
  87.                 launchAppSpec := @SFGFSSpec;
  88.                 launchAppParameters := nil;
  89.             end;
  90.         Call4D(kEX_RESTORE_MACOS_ENV, block);
  91.         err := LaunchApplication(@theLaunchParams);
  92.         Call4D(kEX_RESTORE_MAC4D_ENV, block);
  93.         if err <> noErr then
  94.             begin
  95.                 launchSFG := err;
  96.                 exit(launchSFG);
  97.             end;
  98.         launchSFG := noErr;
  99.  
  100.     end;
  101.  
  102.     procedure PutSFGInFront;
  103.  
  104.         var
  105.             process: ProcessSerialNumber;
  106.             InfoRec: ProcessInfoRec;
  107.             SFGFound: boolean;
  108.             err: OSErr;
  109.             block: ParameterBlock;
  110.  
  111.     begin
  112.         process.highLongOfPSN := 0;
  113.         process.lowLongOfPSN := kNoProcess;
  114.         InfoRec.processInfoLength := sizeof(ProcessInfoRec);
  115.         InfoRec.processName := nil;
  116.         InfoRec.processAppSpec := nil;
  117.         SFGFound := false;
  118.         while not SFGFound & (GetNextProcess(process) = noErr) do
  119.             if GetProcessInformation(process, InfoRec) = noErr then
  120.                 if (InfoRec.processType = longint('APPL')) and (InfoRec.processSignature = SFGsignature) then
  121.                     begin
  122.                         SFGFound := true;
  123.                         Call4D(kEX_RESTORE_MACOS_ENV, block);
  124.                         err := SetFrontProcess(process);
  125.                         Call4D(kEX_RESTORE_MAC4D_ENV, block);
  126.                     end;
  127.     end;
  128.  
  129.  
  130.     procedure MyInitDesc (var desc: AEDesc);
  131.  
  132.     begin
  133.         desc.descriptorType := typeNull;
  134.         desc.dataHandle := nil;
  135.     end;
  136.  
  137.     procedure MyDisposeDesc (var desc: AEDesc);
  138.  
  139.         var
  140.             err: OSErr;
  141.  
  142.     begin
  143.         if (desc.dataHandle <> nil) then
  144.             begin
  145.                 err := AEDisposeDesc(desc);
  146.                 desc.dataHandle := nil;
  147.                 desc.descriptorType := typenull;
  148.             end;
  149.     end;
  150.  
  151.  
  152.  
  153.  
  154.     type
  155.         AEHandlerGlobRec = record
  156.                 TextToReturn: TextBlock;
  157.                 checkdoneFlag: boolean;
  158.                 SFGAevtReturnID: longint;
  159.                 AEcodeErr: OSErr;
  160.             end;
  161.         AEHandlerGlobPtr = ^AEHandlerGlobRec;
  162.  
  163.     function SFGAnswerHandler (theAppleEvent: AppleEvent; reply: AppleEvent; HandlerRefCon: longint): OSErr;
  164.  
  165.         var
  166.             result: AEDesc;
  167.             err: OSErr;
  168.             AevtReturnID: longint;
  169.             actualSize: Size;
  170.             actualTypeCode: DescType;
  171.             theAEHandlerGlobPtr: AEHandlerGlobPtr;
  172.  
  173.     begin
  174.         theAEHandlerGlobPtr := AEHandlerGlobPtr(HandlerRefCon);
  175.         with theAEHandlerGlobPtr^ do
  176.             begin
  177.                 err := AEGetAttributePtr(theAppleEvent, keyReturnIDAttr, typeLongInteger, actualTypeCode, @AevtReturnID, sizeof(longint), actualSize);
  178.                 if (err = noErr) & (SFGAevtReturnID = AevtReturnID) then
  179.                     begin
  180.                         checkdoneFlag := true;
  181.                         err := AEGetParamPtr(theAppleEvent, keyErrorNumber, typeShortInteger, actualTypeCode, @AEcodeErr, SizeOf(OSErr), actualSize);
  182.                         if err = NoErr then
  183.                             begin
  184.                                 if AEcodeErr = noErr then
  185.                                     begin
  186.                                         MyInitDesc(result);
  187.                                         err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeChar, result);
  188.                                         if err = noErr then
  189.                                             begin
  190.                                                 SetHandleSize(Handle(TextToReturn.fData), GetHandleSize(result.dataHandle));
  191.                                                 BlockMove(result.dataHandle^, Handle(TextToReturn.fData)^, GetHandleSize(result.dataHandle));
  192.                                                 TextToReturn.fSize := GetHandleSize(result.dataHandle);
  193.                                             end
  194.                                         else
  195.                                             AEcodeErr := err;
  196.                                         MyDisposeDesc(result);
  197.                                     end
  198.                             end
  199.                         else
  200.                             AEcodeErr := err;
  201.                     end;
  202.                 SFGAnswerHandler := noErr;
  203.             end;
  204.     end;
  205.  
  206.  
  207.     procedure main (entryPoint: Longint; params: PackagePtr; var data: Handle; var resultmain: longint);
  208.  
  209.         var
  210.             checkDialog: DialogPtr;
  211.             AEHandlerGlob: AEHandlerGlobRec;
  212.             oldPort: GrafPtr;
  213.             TextToCheck: TextBlock;
  214.  
  215.         function SendAECheckToSFG: OSErr;
  216.  
  217.             var
  218.                 err: OSerr;
  219.                 targetSignature: OSType;
  220.                 target, directParamDesc, result: AEDesc;
  221.                 evt, reply: AppleEvent;
  222.                 tempRect: Rect;
  223.                 actualTypeCode: DescType;
  224.                 actualSize: Size;
  225.  
  226.         begin
  227.             err := launchSFG;
  228.             if err <> noErr then
  229.                 begin
  230.                     SendAECheckToSFG := err;
  231.                     exit(SendAECheckToSFG);
  232.                 end;
  233.             MyInitDesc(evt);
  234.             MyInitDesc(reply);
  235.             MyInitDesc(directParamDesc);
  236.             MyInitDesc(target);
  237.             targetSignature := SFGsignature;
  238.             err := AECreateDesc(typeApplSignature, @targetSignature, sizeof(targetSignature), target);
  239.             if err = noErr then
  240.                 err := AECreateAppleEvent('WSrv', 'Btch', target, kAutoGenerateReturnID, kAnyTransactionID, evt);
  241.             if err = noErr then
  242.                 err := AEGetAttributePtr(evt, keyReturnIDAttr, typeLongInteger, actualTypeCode, @AEHandlerGlob.SFGAevtReturnID, sizeof(longint), actualSize);
  243.             HLock(Handle(TextToCheck.fData));
  244.             if err = noErr then
  245.                 err := AECreateDesc(typeChar, Handle(TextToCheck.fData)^, TextToCheck.fSize, directParamDesc);
  246.             HUnlock(Handle(TextToCheck.fData));
  247.             if err = noErr then
  248.                 err := AEPutParamDesc(evt, keyDirectObject, directParamDesc);
  249.             if err = noErr then
  250.                 err := AESend(evt, reply, kAEQueueReply + kAEAlwaysInteract + kAECanSwitchLayer, kAENormalPriority, kNoTimeOut, nil, nil);
  251.             MyDisposeDesc(evt);
  252.             MyDisposeDesc(reply);
  253.             MyDisposeDesc(directParamDesc);
  254.             MyDisposeDesc(target);
  255.             SendAECheckToSFG := err;
  256.         end;
  257.  
  258.  
  259.  
  260.         procedure TreatActivateUpdateOSDialogEvent (theEvent: EventRecord);
  261.  
  262.             var
  263.                 oldPort: GrafPtr;
  264.  
  265.         begin
  266.             case theEvent.what of
  267.                 ActivateEvt, osEvt: 
  268.                     ;
  269.                 updateEvt: 
  270.                     if WindowPtr(theEvent.message) = checkDialog then
  271.                         begin
  272.                             BeginUpdate(checkDialog);
  273.                             GetPort(oldPort);
  274.                             SetPort(checkDialog);
  275.                             UpdtDialog(checkDialog, checkDialog^.visRgn);
  276.                             SetPort(oldPort);
  277.                             EndUpdate(checkDialog);
  278.                         end;
  279.             end;
  280.         end;
  281.  
  282.         procedure EnableDisableMenuBar (Enable: boolean);
  283.  
  284.             var
  285.                 theMenuBar: CharsHandle;
  286.                 NumOfMenus, indMenu: integer;
  287.                 aMenuHandle: MenuHandle;
  288.  
  289.         begin
  290.             theMenuBar := CharsHandle(GetMenuBar);
  291.             BlockMove(@theMenuBar^^[0], @NumOfMenus, sizeof(integer));
  292.             NumOfMenus := NumOfMenus div 6;
  293.             for indMenu := 0 to NumOfMenus - 1 do
  294.                 begin
  295.                     BlockMove(@theMenuBar^^[6 + indMenu * 6], @aMenuHandle, sizeof(aMenuHandle));
  296.                     if Enable then
  297.                         EnableItem(aMenuHandle, 0)
  298.                     else
  299.                         DisableItem(aMenuHandle, 0);
  300.                 end;
  301.             DisposHandle(Handle(theMenuBar));
  302.             DrawMenuBar;
  303.         end;
  304.  
  305.         procedure EndMain;
  306.  
  307.             var
  308.                 err: OSerr;
  309.  
  310.         begin
  311.             err := AERemoveEventHandler(kCoreEventClass, kAEAnswer, @SFGAnswerHandler, false);
  312.             EnableDisableMenuBar(true);
  313.             DisposeDialog(checkDialog);
  314.             SetPort(oldPort);
  315.             TextPtr(params^[2])^ := AEHandlerGlob.TextToReturn;
  316.         end;
  317.  
  318.  
  319.  
  320.         var
  321.             whichWindow: WindowPtr;
  322.             theEvent: EventRecord;
  323.             err: OSerr;
  324.             dragRect: Rect;
  325.             MousePt: Point;
  326.             whichControl: ControlHandle;
  327.             ignore: longint;
  328.  
  329.     begin
  330.         if entryPoint = 1 then
  331.             begin
  332.                 TextToCheck := TextPtr(params^[1])^;
  333.                 AEHandlerGlob.TextToReturn.fSize := 0;
  334.                 if TextPtr(params^[2])^.fData <> nil then
  335.                     begin
  336.                         AEHandlerGlob.TextToReturn.fData := TextPtr(params^[2])^.fData;
  337.                         SetHandleSize(Handle(AEHandlerGlob.TextToReturn.fData), 0);
  338.                     end
  339.                 else
  340.                     AEHandlerGlob.TextToReturn.fData := XHANDLE(NewHandle(0));
  341.                 with dragRect do
  342.                     SetRect(dragRect, 4, 24, maxint, maxint);
  343.                 GetPort(oldPort);
  344.                 checkDialog := GetNewDialog(CheckDialogID, nil, WindowPtr(-1));
  345.                 SetPort(checkDialog);
  346.                 ShowWindow(checkDialog);
  347.                 AEHandlerGlob.checkdoneFlag := false;
  348.                 EnableDisableMenuBar(false);
  349.                 err := AEInstallEventHandler(kCoreEventClass, kAEAnswer, @SFGAnswerHandler, longint(@AEHandlerGlob), false);
  350.                 err := SendAECheckToSFG;
  351.                 if err <> noErr then
  352.                     begin
  353.                         EndMain;
  354.                         resultmain := err;
  355.                         exit(main);
  356.                     end;
  357.                 repeat
  358.                     if WaitNextEvent(everyEvent, theEvent, 30, nil) then
  359.                         case theEvent.what of
  360.                             ActivateEvt, UpdateEvt, osEvt: 
  361.                                 TreatActivateUpdateOSDialogEvent(theEvent);
  362.                             kHighLevelEvent: 
  363.                                 err := AEProcessAppleEvent(theEvent);
  364.                             mouseDown: 
  365.                                 case FindWindow(theEvent.where, whichWindow) of
  366.                                     inSysWindow: 
  367.                                         SystemClick(theEvent, whichWindow);
  368.                                     inDrag: 
  369.                                         if whichWindow = checkDialog then
  370.                                             DragWindow(whichWindow, theEvent.where, dragRect);
  371.                                     inMenuBar: 
  372.                                         ignore := MenuSelect(theEvent.where);
  373.                                     inContent: 
  374.                                         if whichWindow = checkDialog then
  375.                                             begin
  376.                                                 MousePt := theEvent.where;
  377.                                                 GlobalToLocal(MousePt);
  378.                                                 if (FindControl(MousePt, checkDialog, whichControl) = inButton) & (TrackControl(whichControl, MousePt, nil) = inButton) then
  379.                                                     PutSFGInFront;
  380.                                             end;
  381.  
  382.                                     otherwise
  383.                                         SysBeep(1);
  384.                                 end;
  385.                         end;
  386.                 until AEHandlerGlob.checkdoneFlag;
  387.                 EndMain;
  388.                 resultmain := AEHandlerGlob.AEcodeErr;
  389.             end
  390.         else
  391.             resultmain := noErr;
  392.     end;
  393.  
  394.  
  395. end.